home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DRIVES.SWG / 0057_VOL Label Functions.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-21  |  3KB  |  118 lines
  1. UNIT VolFuncs;
  2. (**) INTERFACE (**)
  3. USES Dos;
  4. TYPE
  5.   VolString = String[12];
  6.  
  7.   FUNCTION GetLabel(driveNum : Byte;
  8.                     VAR V : VolString) : Boolean;
  9.   FUNCTION SetLabel(driveNum : Byte;
  10.                     NuLabel : VolString) : Boolean;
  11.   FUNCTION DelLabel(driveNum : Byte) : Boolean;
  12.  
  13. (**) IMPLEMENTATION (**)
  14. TYPE
  15.   ExFCB = RECORD
  16.             FF        : Byte;              {must be 0FFh}
  17.             Reserved0 : ARRAY[1..5] OF Byte; {must be 0s}
  18.             Attribute : Byte;
  19.             DriveID   : Byte;
  20.             Filename  : ARRAY[1..8] OF Char;
  21.             Extension : ARRAY[1..3] OF Char;
  22.             CurBlock  : Word;
  23.             RecSize   : Word;
  24.             FileSize  : LongInt;
  25.             Date      : Word;
  26.             Time      : Word;
  27.             Reserved  : ARRAY[1..8] OF Byte;
  28.             CurRec    : Byte;
  29.             Relative  : LongInt;
  30.           END;
  31.  
  32.   FUNCTION GetLabel(driveNum : Byte;
  33.                     VAR V : VolString) : Boolean;
  34.   CONST
  35.     Any : String[5] = ':\*.*';
  36.   VAR
  37.     SR   : SearchRec;
  38.     Mask : PathStr;
  39.     P    : Byte;
  40.   BEGIN
  41.     IF DriveNum > 0 THEN
  42.       Mask[1] := Char(DriveNum + ord('@'))
  43.     ELSE GetDir(0, Mask);
  44.     Move(Any[1], Mask[2], 5);
  45.     Mask[0] := #6;
  46.     FindFirst(Mask, VolumeID, SR);
  47.     WHILE (SR.Attr AND VolumeID = 0) AND
  48.           (DosError = 0) DO
  49.       FindNext(SR);
  50.     IF DosError = 0 THEN
  51.       BEGIN
  52.         FillChar(V[1], 11, ' ');
  53.         V[0] := #11;
  54.         P := Pos('.', SR.Name);
  55.         IF P = 0 THEN
  56.           Move(SR.Name[1], V[1], length(SR.Name))
  57.         ELSE
  58.           BEGIN
  59.             Move(SR.Name[1], V[1], pred(P));
  60.             Move(SR.Name[P+1], V[9], length(SR.Name)-P);
  61.           END;
  62.         GetLabel := TRUE;
  63.       END
  64.     ELSE GetLabel := FALSE;
  65.   END;
  66.  
  67.   FUNCTION SetLabel(driveNum : Byte;
  68.                     NuLabel : VolString) : Boolean;
  69.   VAR E  : ExFCB;
  70.   BEGIN
  71.     WITH E DO
  72.       BEGIN
  73.         FF        := $FF;
  74.         FillChar(Reserved0, 5, 0);
  75.         Attribute := VolumeID;
  76.         DriveID   := DriveNum;
  77.         FillChar(FileName, 8, ' ');
  78.         FillChar(Extension, 3, ' ');
  79.         Move(NuLabel[1], Filename, length(NuLabel));
  80.       END;
  81.     ASM
  82.       PUSH DS
  83.       MOV AX, SS
  84.       MOV DS, AX
  85.       LEA DX, E    {point DS:DX at Extended FCB}
  86.       MOV AH, 16h  {create using FCB}
  87.       INT 21h
  88.       INC AL
  89.       MOV @result, AL
  90.       POP DS
  91.     END;
  92.   END;
  93.  
  94.   FUNCTION DelLabel(driveNum : Byte) : Boolean;
  95.   VAR E   : ExFCB;
  96.   BEGIN
  97.     WITH E DO
  98.       BEGIN
  99.         FF        := $FF;
  100.         FillChar(Reserved0, 5, 0);
  101.         Attribute := VolumeID;
  102.         DriveID   := DriveNum;
  103.         FillChar(FileName, 8, '?');
  104.         FillChar(Extension, 3, '?');
  105.       END;
  106.     ASM
  107.       PUSH DS
  108.       MOV AX, SS
  109.       MOV DS, AX
  110.       LEA DX, E    {point DS:DX at Extended FCB}
  111.       MOV AH, 13h  {delete using FCB}
  112.       INT 21h
  113.       INC AL
  114.       MOV @Result, AL
  115.       POP DS
  116.     END;
  117.   END;
  118. END.